Projectivity vs Arousal

Norming valence mean to get positive and negative valence

emotion <- emotion_select %>%
  mutate(valence_scaled = scale(V.Mean.Sum))
word_list <- unique(emotion$Word)

# Need to filter by acceptability (see 2019 paper)
# Need to normalize by participants (2016 paper used "ordinal model-based normalization procedure")
vp_data <- vp_data %>%
  mutate(veridicality_num = ifelse(veridicality == "yes", 1, ifelse(veridicality == "no", -1, 0))) %>%
  filter(exclude == "False") %>%
  mutate(Word = verb) %>%
  filter(Word %in% word_list)

create relevant subset for veridicality ratings

# the White paper (2016) uses only observations with case "that_S" to calculate veridicality, not sure if this is important
veridicality_filter <- vp_data %>%
  filter(polarity == "positive" & conditional == "False") %>%
  group_by(Word)
  
veridicality_ratings <- veridicality_filter %>%
  multi_boot_standard(col = "veridicality_num") %>%
  mutate(veridicality_mean = mean, YMin = mean - ci_lower, YMax = mean + ci_upper) %>%
  ungroup(Word) %>%
  mutate(Word = fct_reorder(as.factor(Word), mean))

veridicality <- merge(veridicality_ratings, emotion, by = "Word", all.x = TRUE) 
veridicality <- veridicality %>%
  rename(valence_mean = valence_scaled, arousal_mean = A.Mean.Sum, valence_SD = V.SD.Sum, arousal_SD = A.SD.Sum) %>%
  mutate(valence_group = ifelse(valence_mean < 0, "negative", "positive"))

ggplot(data = veridicality, aes(x = valence_mean, y = veridicality_mean, colour = valence_group, label = Word)) +
  #geom_point(width = .3,height = .025) +
  geom_label() + 
  geom_smooth(method = 'lm')

ggplot(data = veridicality, aes(x = arousal_mean, y = veridicality_mean, colour = valence_group, label = Word)) +
  #geom_point(width = .3,height = .025) + 
  facet_grid(~valence_group) +
  geom_label() + 
  geom_smooth(method = 'lm')

veridicality$relativeValence = abs(veridicality$valence_mean)
m = lm(mean ~ relativeValence + arousal_mean, data = veridicality)
summary(m)

## 
## Call:
## lm(formula = mean ~ relativeValence + arousal_mean, data = veridicality)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.41820 -0.21724 -0.01319  0.28322  0.59013 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      0.426279   0.066204   6.439 2.35e-10 ***
## relativeValence  0.002703   0.024926   0.108    0.914    
## arousal_mean    -0.003015   0.016361  -0.184    0.854    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3604 on 647 degrees of freedom
## Multiple R-squared:  5.487e-05,  Adjusted R-squared:  -0.003036 
## F-statistic: 0.01775 on 2 and 647 DF,  p-value: 0.9824

create relevant subset for projectivity ratings

projectivity_filter <- vp_data %>%
  filter(polarity == "negative" & conditional == "True") %>%
  group_by(Word)

projectivity_ratings <- projectivity_filter %>%
  multi_boot_standard(col = "veridicality_num") %>%
  mutate(projectivity_mean = mean, YMin = mean - ci_lower, YMax = mean + ci_upper) %>%
  ungroup(Word) %>%
  mutate(Word = fct_reorder(as.factor(Word), mean))

projectivity <- merge(projectivity_ratings, emotion, by = "Word", all.x = TRUE) 

projectivity <- projectivity %>%
  rename(valence_mean = valence_scaled, arousal_mean = A.Mean.Sum, valence_SD = V.SD.Sum, arousal_SD = A.SD.Sum) %>%
  mutate(valence_group = ifelse(valence_mean < 0, "negative", "positive"))

ggplot(data = projectivity, aes(x = valence_mean, y = projectivity_mean, colour = valence_group, label = Word)) +
  #geom_point(width = .3,height = .025) +
  geom_label() +
  geom_smooth(method = 'lm')

ggplot(data = projectivity, aes(x = arousal_mean, y = projectivity_mean, colour = valence_group, label = Word)) +
  #geom_point(width = .3,height = .025) + 
  facet_grid(~valence_group) +
  geom_label() +
  geom_smooth(method = 'lm')

projectivity against arousal_mean, by valence_bins

projectivity_neg <- projectivity %>%
  filter(valence_group == "negative")
projectivity_neg <-projectivity_neg[order(projectivity_neg$valence_mean),]
projectivity_neg[c("valence_bin")] <- 0
sep_neg = nrow(projectivity_neg) / 3 # 63.66667
for (i in 1:nrow(projectivity_neg)) {
  if (i <= sep_neg) {
    projectivity_neg[i, "valence_bin"] <- "very negative" #contains 63 items
  } else if (i <= 2 * sep_neg) {
    projectivity_neg[i, "valence_bin"] <- "moderately negative" # contains 64 items
  } else {
    projectivity_neg[i, "valence_bin"] <- "slightly negative" # contains 64 items
  }
}

projectivity_pos <- projectivity %>%
  filter(valence_group == "positive")
projectivity_pos <-projectivity_pos[order(projectivity_pos$valence_mean),]
projectivity_pos[c("valence_bin")] <- 0
sep_pos = nrow(projectivity_pos) / 3 # 77.3333
for (i in 1:nrow(projectivity_pos)) {
  if (i <= sep_pos) {
    projectivity_pos[i, "valence_bin"] <- "slightly positive" # contains 77 items 
  } else if (i <= 2 * sep_pos) {
    projectivity_pos[i, "valence_bin"] <- "moderately positive" # contains 77 items
  } else {
    projectivity_pos[i, "valence_bin"] <- "very positive" # contains 78 items
  }
}

projectivity_bin <- rbind(projectivity_neg, projectivity_pos)
projectivity_bin$valence_bin_f = factor(projectivity_bin$valence_bin, levels=c("very negative", "moderately negative", "slightly negative", "slightly positive", "moderately positive", "very positive"))
ggplot(data = projectivity_bin, aes(x = arousal_mean, y = mean, colour = valence_bin_f, label = Word)) +
  #geom_point(width = .3,height = .025) + 
  facet_grid(~valence_bin_f) +
  geom_label() +
  geom_smooth(method = 'lm')

projectivity$relativeValence = abs(projectivity$valence_mean)
m = lm(mean ~ relativeValence + arousal_mean, data = projectivity)
summary(m)

## 
## Call:
## lm(formula = mean ~ relativeValence + arousal_mean, data = projectivity)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.80637 -0.19107 -0.02518  0.16959  0.86177 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -0.20776    0.06488  -3.202 0.001467 ** 
## relativeValence  0.18335    0.02382   7.698 9.96e-14 ***
## arousal_mean     0.06102    0.01609   3.792 0.000172 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2791 on 420 degrees of freedom
## Multiple R-squared:  0.2188, Adjusted R-squared:  0.215 
## F-statistic:  58.8 on 2 and 420 DF,  p-value: < 2.2e-16

projectivity_ratings_participant <- projectivity_filter

projectivity_participant <- merge(projectivity_ratings_participant, emotion, by = "Word", all.x = TRUE) 
projectivity_participant <- projectivity_participant %>%
  rename(valence_mean = valence_scaled, arousal_mean = A.Mean.Sum, valence_SD = V.SD.Sum, arousal_SD = A.SD.Sum) %>%
  mutate(valence_group = ifelse(valence_mean < 0, "negative", "positive"))

projectivity_participant$relativeValence = abs(projectivity_participant$valence_mean)
m = lmer(veridicality_num ~ arousal_mean * relativeValence + (1 | participant) + (1 | Word), data = projectivity_participant)
summary(m)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## veridicality_num ~ arousal_mean * relativeValence + (1 | participant) +  
##     (1 | Word)
##    Data: projectivity_participant
## 
## REML criterion at convergence: 6062.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7903 -0.5219 -0.0759  0.5784  3.6057 
## 
## Random effects:
##  Groups      Name        Variance Std.Dev.
##  Word        (Intercept) 0.05401  0.2324  
##  participant (Intercept) 0.04782  0.2187  
##  Residual                0.18567  0.4309  
## Number of obs: 4450, groups:  Word, 423; participant, 160
## 
## Fixed effects:
##                               Estimate Std. Error t value
## (Intercept)                  -0.159031   0.121447  -1.309
## arousal_mean                  0.047661   0.028731   1.659
## relativeValence               0.147523   0.105514   1.398
## arousal_mean:relativeValence  0.008049   0.022795   0.353
## 
## Correlation of Fixed Effects:
##             (Intr) arsl_m rltvVl
## arousal_men -0.969              
## relativVlnc -0.810  0.766       
## arsl_mn:rlV  0.844 -0.838 -0.975